Final Proyect Data Analyst R

Data Profiling

Contexto

El siguiente proyecto tiene como finalidad hacer un análisis exploratorio sobre los datos históricos de los meses de enero hasta julio del año 2018 proporcionados por la página de ecobici; en la misma liga se puede econtrar lo necesario para accesar al API proporcionado por este servicio. La documentación sobre la API se encuentra en la siguiente liga

Ecobici es un servicio de bicicletas públicas de la Ciudad de México dirigido a los habitantes de la capital, de sus alrededores y a los turistas.

El funcionamiento de este servicio permite a los usuarios registrados tomar una bicicleta de cualquier cicloestación y devolverla en la más cercana a su destino en trayectos ilimitados de 45 minutos.

La forma para acceder a este servicio es mediante un suscripción anual, semanal, de cada tres días o diaria

Este servicio está disponible en un horario de 5:00 hrs hasta 00:30 hrs todos los días del año, el cuál inicio en el año 2010, febrero con 84 cicloestaciones y mil 200 bicicletas.

Actualmente Ecobici cuenta con más de 170 mil usuarios registrados y el servicio está disponible en 55 colonias de la Ciudad de México, en un área de 38 kilómetros cuadrados.

El API de ecobicise enfoca en datos actuales y el objetivo es sobre los datos históricos, para su obtención no es necesario utilizar la API.

Los datos fueron descargados y almacenados en una BD llamada ECOBICI; el dump para exportar esta BD se encuentra en los archivos suministrados en este proyecto en la carpeta data

La BD ECOBICI contiene 7 tablas, una por cada mes, es decir, una por cada archivo descargado directamente de la página de ecobici; cada tabla contiene los siguientes campos:

gender_user: Genero del usuario que utilizó el servicio ecobici.
year_user: Edad del usuario que utilizó el servicio ecobici.
id_bici: Identificador de la bicicleta utilizada.
re_station: Identificador de la estación donde se retiró la bicicleta.
re_date: Fecha de retiro de la bicicleta de la última estación registada para su utilzación.
re_time: Hora de retiro de la bicicleta de la última estación registrada para su utilización.
arr_station: Identificador de la estación donde se deposita la bicicleta.
arr_station: Fecha de llegada de la bicicleta a la estación de arrivo.
arr_time: Hora de llegada de la bicicleta a la estación de arrivo.

Se procederá a la conexión y extracción de datos desde la BD

library(tidyverse)
library(lubridate)
library(pool)
library(DBI)
library(RMySQL)
library(knitr)
library(ggmap)
library(plotly)

db.host <- 'localhost'
db.user <- 'root'
db.port <- 3306
db.password <- '5up3rm4n'

## DB Connection
db_connect <- function(db.name) {
  db <- dbPool(
    drv = RMySQL::MySQL(),
    dbname = db.name,
    host = db.host,
    user = db.user,
    password = db.password,
    port = as.numeric(db.port)
  )
  
  return(db)
}

Nos interesa hacer un análisis sobre todos los datos por lo que, para evitar seleccionar todo por partes de cada tabla, se extraeran todos los datos de cada tabla.

January <- tbl(db_connect('ECOBICI'), "Enero") %>% collect()
February <- tbl(db_connect('ECOBICI'), "Febrero") %>% collect()
March <- tbl(db_connect('ECOBICI'), "Marzo") %>% collect()
April <- tbl(db_connect('ECOBICI'), "Abril") %>% collect()
May <- tbl(db_connect('ECOBICI'), "Mayo") %>% collect()
June <- tbl(db_connect('ECOBICI'), "Junio") %>% collect()
July <- tbl(db_connect('ECOBICI'), "Julio") %>% collect()

Ahora, un poco de limpieza

January

Con la siguiente función se modificará el tipo de dato en gender_user y se colapsará los datos de tiempo y fecha en un sólo dato para los tiempos de arrivo y los tiempos de retiro registrados

gender_arr_fix <- function(data){
  new_data <- data %>% mutate(gender_user = factor(gender_user, levels = c("M", "F")), 
                              arr_time = str_replace(arr_time, "(\\w+:\\w+:\\w+)\\r", "\\1"),
                              re_date = dmy(re_date), re_time = hms(re_time), 
                              arr_date = dmy(arr_date), arr_time = hms(arr_time)) %>% 
    mutate(re_datetime = make_datetime(year(re_date),
                                       month(re_date), 
                                       day(re_date),
                                       hour(re_time), 
                                       minute(re_time),
                                       second(re_time)), 
           arr_datetime = make_datetime(year(arr_date),
                                       month(arr_date), 
                                       day(arr_date),
                                       hour(arr_time), 
                                       minute(arr_time),
                                       second(arr_time))) %>% 
    select(-c(re_date, re_time, arr_date, arr_time))
  return(new_data)
}

January <- gender_arr_fix(January)
February <- gender_arr_fix(February)
March <- gender_arr_fix(March)
April <- gender_arr_fix(April)
May <- gender_arr_fix(May)
June <- gender_arr_fix(June)
July <- gender_arr_fix(July)

April

Para realizar un perfilamiento de datos se hace uso del módulo `DataProfiling el cual se encuentra en los documentos de este proyecto

source("DataProfiling.R")

Ahora, se hará el data profiling por cada mes

Hay que observar que year_user, id_bici, re_station, arr_station son identificadores, por lo que, aunque sean de tipo numérico, no proporcionan alguna información cuantitativa relevante, por lo que solo se observarán características sobre los datos que no incluya resumenes numericos.

Primero un conteo de datos, después un resumen sobre cada mes.

Enero

J_fac <- January %>% select(-c(re_datetime, arr_datetime))
J_date <- January %>% select(c(re_datetime, arr_datetime))

J_factor <- J_fac %>% profiling("categorical")
kable(J_factor, format.args = list(big.mark=",", scientific=F))

	uniques	mode
gender_user	2	M
year_user	67	28
id_bici	4,897	7376
re_station	432	271
arr_station	435	1

En el mes de enero, la mayoría de los usuarios son de género masculino, la mayoría de los usuarios tienen 28 años, se tiene una preferencia sobre la bicicleta con id 7376,además de un preferencia en la estación 271 para retirar bicicletas y depositarlas en la estación 1

Para los datos de tiempo sólo se verifica si existen valores nulos y el conteo de los valores únicos.

J_datetime <- J_date %>% profiling("other")
kable(J_datetime, format.args = list(big.mark=",", scientific=F))

	uniques	nan
re_datetime	545,217	0
arr_datetime	545,660	0

Febrero

F_fac <- February %>% select(-c(re_datetime, arr_datetime))
F_date <- February %>% select(c(re_datetime, arr_datetime))

F_factor <- F_fac %>% profiling("categorical")
kable(F_factor, format.args = list(big.mark=",", scientific=F))

	uniques	mode
gender_user	2	M
year_user	73	28
id_bici	5,058	2019
re_station	476	271
arr_station	476	43

F_datetime <- F_date %>% profiling("other")
kable(F_datetime, format.args = list(big.mark=",", scientific=F))

	uniques	nan
re_datetime	541,252	0
arr_datetime	541,095	0

En el caso del mes de febrero, se mantienen el genero y la edad de los usuarios, en este caso se tiene una preferencia sobre la bicicleta con id 2019 , la estación 271 para retirar bicicletas y depositarlas en la estación 43.

Marzo

M_fac <- March %>% select(-c(re_datetime, arr_datetime))
M_date <- March %>% select(c(re_datetime, arr_datetime))

M_factor <- M_fac %>% profiling("categorical")
kable(M_factor, format.args = list(big.mark=",", scientific=F))

	uniques	mode
gender_user	2	M
year_user	72	28
id_bici	4,931	2698
re_station	476	271
arr_station	478	27

M_datetime <- M_date %>% profiling("other")
kable(M_datetime, format.args = list(big.mark=",", scientific=F))

	uniques	nan
re_datetime	580,412	0
arr_datetime	579,596	0

Para el mes de marzo, se sigue conservando la tendencia sobre la edad y genero de los usuarios, en este mes se tiene una preferencia sobre la bicicleta con id 2698, sigue una preferencia en la estación 271 para retirar bicicletas y la estación para depositarlas en este mes con mayor preferencia es la estación 27

Abril

A_fac <- April %>% select(-c(re_datetime, arr_datetime))
A_date <- April %>% select(c(re_datetime, arr_datetime))

A_factor <- A_fac %>% profiling("categorical")
kable(A_factor, format.args = list(big.mark=",", scientific=F))

	uniques	mode
gender_user	2	M
year_user	71	28
id_bici	4,889	11065
re_station	478	27
arr_station	478	27

A_datetime <- A_date %>% profiling("other")
kable(A_datetime, format.args = list(big.mark=",", scientific=F))

	uniques	nan
re_datetime	589,901	0
arr_datetime	589,669	0

En el mes de abril, sigue la tendencia sobre la edad y genero de los usuarios; ahora la bicicleta de preferencia es aquella con id 11065 y la estación preferida en este es para retirar y depositar la bicicleta es la número 27.

Mayo

May_fac <- May %>% select(-c(re_datetime, arr_datetime))
May_date <- May %>% select(c(re_datetime, arr_datetime))

May_factor <- May_fac %>% profiling("categorical")
kable(May_factor, format.args = list(big.mark=",", scientific=F))

	uniques	mode
gender_user	2	M
year_user	72	28
id_bici	4,982	15259
re_station	480	271
arr_station	480	27

May_datetime <- May_date %>% profiling("other")
kable(May_datetime, format.args = list(big.mark=",", scientific=F))

	uniques	nan
re_datetime	618,668	0
arr_datetime	618,486	0

En el mes de mayo, se conservan las anteriores tendencias en la edad y genero de los usuarios; la bicicleta de preferencia es aquella con id 15259 y finalmente, hay preferencia en la estación 271 para retirar bicicletas, con sucedio en el mes de enero y la preferencia para depositarlas en la estación 27 tal como sucedio en el mes de marzo.

Junio

Jun_fac <- June %>% select(-c(re_datetime, arr_datetime))
Jun_date <- June %>% select(c(re_datetime, arr_datetime))

Jun_factor <- Jun_fac %>% profiling("categorical")
kable(Jun_factor, format.args = list(big.mark=",", scientific=F))

	uniques	mode
gender_user	2	M
year_user	71	28
id_bici	4,980	2789
re_station	479	271
arr_station	479	27

Jun_datetime <- Jun_date %>% profiling("other")
kable(Jun_datetime, format.args = list(big.mark=",", scientific=F))

	uniques	nan
re_datetime	545,135	0
arr_datetime	545,241	0

En el mes de junio, sigue la tendencia de genero y edad sobre los usuarios, ahora hay preferencia sobre la bicicleta con id 2789, y al igual de mayo, hay preferencia en la estación 271 para retirar bicicletas, con sucedio en el mes de enero y la preferencia para depositarlas en la estación 27

Julio

July_fac <- July %>% select(-c(re_datetime, arr_datetime))
July_date <- July %>% select(c(re_datetime, arr_datetime))

July_factor <- July_fac %>% profiling("categorical")
kable(July_factor, format.args = list(big.mark=",", scientific=F))

	uniques	mode
gender_user	2	M
year_user	70	28
id_bici	4,929	9581
re_station	480	27
arr_station	480	27

July_datetime <- July_date %>% profiling("other")
kable(July_datetime, format.args = list(big.mark=",", scientific=F))

	uniques	nan
re_datetime	568,438	0
arr_datetime	569,168	0

Finalmente para el mes de julio, se conservo la tendencia de edad y genero como en todos los meses, el id de la bicicleta de preferencia en este mes es 9581 y al igual que el mes de abril la estación preferida para retirar y depositar la bicicleta es la número 27.

Vease que la estación número 271 es la que tiene un mayor número de registros donde los usuarios obtuvieron bicicletas en los meses de :

Enero, Febrero, Marzo, Mayo y Junio.

Por otro lado, la estación 27 en los meses de Abril y Julio es donde se obtienen la mayor cantidad de registros donde los usuarios obtuvieron una bicicleta. Esta estación es tienen la mayoría donde los usuarios depositan una bicicleta en los meses de :

Marzo, Abril, Mayo, Junio y Julio.

Ahora, surgen varias preguntas o issues sobre los datos.

EDA

¿Dónde se ubican las estaciones más recurrentes? Es decir, las estaciones con el id 27 y 271.

Un mapa de todas las cicloestaciones se encuentra en la página oficial de ecobici, aunque en esta liga se encuentra el archivo correspondiente.

La ubicación de cada una de las 480 estaciones se encuentra en la siguiente página

Las anteriores estaciones son las siguientes:

27 REFORMA-HAVRE

first_station <- geocode('Paseo de la Reforma, Juárez, 06600 Ciudad de México, Ciudad de México, México', 
                  source = "google")
map_first_station <- get_map(location = as.numeric(first_station),
                      color = "color",
                      maptype = "roadmap",
                      scale = 2,
                      zoom = 16)
ggmap(map_first_station) + geom_point(aes(x = lon, y = lat),
                               data = first_station , colour = 'red',
                               shape = 23, size = 4, fill= "orange")

271 AV. CENTRAL-J. MENESES

second_station <- geocode('Jesús García 271, Buenavista, 06350 Ciudad de México, CDMX, México', 
                  source = "google")

map_second_station <- get_map(location = as.numeric(first_station),
                      color = "color",
                      maptype = "roadmap",
                      scale = 1,
                      zoom = 14)

ggmap(map_second_station) + geom_point(aes(x = lon, y = lat),
                               data = second_station , colour = 'red',
                               shape = 23, size = 4, fill= "orange")

## Warning: Removed 1 rows containing missing values (geom_point).

Ambas estaciones están ubicadas en zonas donde hay una gran cantidad de personas y movilidad.

Recordar que en el mes de Junio se tienen a estas dos como más recurrentes por lo que un vistazo sobre la ruta sería excelente.

Mapa_CDMX <- get_map("Londres 6, Juárez, 06600 Ciudad de México, CDMX", source = "google",  zoom = 16, maptype = "roadmap", color = "color")

ruta <- route(from = "Jesús García 271, Buenavista, 06350 Ciudad de México, CDMX, México", to = "Paseo de la Reforma, Juárez, 06600 Ciudad de México, Ciudad de México, México")

ggmap(Mapa_CDMX) + 
  geom_path(aes(x = startLon, y = startLat, xend = endLon, yend = endLat),
            colour = "red", size = 2, data = ruta)

Para tener todos los datos recabados en los meses de enero hasta julio del 2018, se junta todo para así obtener el tiempo promedio que los usuarios utilizan el servicio de ecobici desde la estación 271 hasta la 27

bicycle_history_ecobici <- rbind(January, February, March, April, May, June, July)

Ahora se agrega el tiempo que un usuario utilizo alguna bicicleta:

bicycle_history_ecobici <- bicycle_history_ecobici %>% 
  mutate(duracion = as.duration(arr_datetime-re_datetime))
bicycle_history_ecobici

Ahora, vease lo siguiente:

bicycle_history_ecobici %>% arrange(duracion)

Hay registros donde los usuarios tardarón 0 y hasta 1 segundo en dejar una bicicleta en estaciones distintas

bicycle_history_ecobici %>% arrange(desc(duracion)) %>% filter(re_station != arr_station)

Hay registros donde los usuarios tardaron ¡AÑOS! en devolver una bicicleta, también semanas y hasta días; y no solo eso

Esto muestra que hay registros que no tienen mucho sentido, por lo que se tomarán aquellos con una duración a 30 segundos de una estación a otra y aquellos que cumplan con el reglamento establecido de ecobici en cuanto a la duración reglamentaria, es decir, 45 minutos

new_bicycle_history_ecobici <- bicycle_history_ecobici %>% filter(duracion <= dminutes(45))
new_bicycle_history_ecobici <- new_bicycle_history_ecobici %>% filter(dseconds(30) <= duracion)
new_bicycle_history_ecobici %>% arrange(duracion)

new_bicycle_history_ecobici %>% arrange(desc(duracion))

Con esta nueva limpieza, obtenemos aquellos registros entre las dos estaciones de estudio (271, 27)

new_bicycle_history_ecobici %>% 
  filter((re_station == 271 & arr_station == 27) | (re_station == 27 & arr_station == 271))

Y el tiempo promedio que hacen los usuarios en esta ruta es de:

new_bicycle_history_ecobici %>% 
  filter((re_station == 271 & arr_station == 27) | (re_station == 27 & arr_station == 271)) %>%
  summarise(tiempo_promedio = mean(duracion)) %>% 
  mutate(tiempo_promedio = dseconds(tiempo_promedio))

Es natural preguntarse lo siguiente : ¿Si estoy en una parada, cuál es el promedio de tiempo que debería esperar para obtener una bicicleta en una estación dada?

Lo siguiente se hará por horas

median_by_station_hour <- function(estacion, hora){
  fecha_aux <- make_datetime(2018, 8, 8, hora, 0,0)
  resultado <- new_bicycle_history_ecobici %>% 
    filter(arr_station == estacion) %>% 
    mutate(hora = hour(arr_datetime), minutos = minute(arr_datetime)) %>% 
    arrange(hora, minutos) %>% 
    group_by(hora) %>% 
    mutate(diferencia_tiempos = minutos -lag(minutos)) %>% 
    dplyr::summarise(mean_minutes = mean(diferencia_tiempos, na.rm = TRUE)) %>% 
    filter(hora == hour(fecha_aux))
  resultado
}

Por ejemplo, si me interesa la estación con id 271 y son las dos de la tarde con algunos minutos

median_by_station_hour(271, 14)

Entonces a las 14 horas, en 0.037 minutos es el promedio de tiempo que tiene la estación registrada para que algún otro usuario regrese alguna bicicleta a la estación 271.

Este valor es bajo aunque no raro ya que tomamos la estación con mayor número de registros.

Por ejemplo, para otras estaciones, hay que esperar más:

median_by_station_hour(3000, 15)

Ya que la estación 271 es de las más importantes, una gráfica del comportamiento por horas ayuda a elegir una hora para tomar una bicicleta en esta estación

all_time <- function(estacion){
  resultado <- new_bicycle_history_ecobici %>% 
    filter(arr_station == estacion) %>% 
    mutate(hora = hour(arr_datetime), minutos = minute(arr_datetime)) %>% 
    arrange(hora, minutos) %>% 
    group_by(hora) %>% 
    mutate(diferencia_tiempos = minutos -lag(minutos)) %>% 
    dplyr::summarise(mean_minutes = mean(diferencia_tiempos, na.rm = TRUE))
  return(resultado)
}

estacion_271 <- all_time(271) %>% 
  ggplot(aes(x = hora, y = mean_minutes)) + 
  geom_line() +
  ggtitle("Espera en minutos sobre la estación 271 a lo largo del día")
ggplotly(estacion_271)

Para la estación 27 se tiene el correspondiente gráfico

estacion_27 <- all_time(27) %>% 
  ggplot(aes(x = hora, y = mean_minutes)) + 
  geom_line() +
  ggtitle("Espera en minutos sobre la estación 27 a lo largo del día")
ggplotly(estacion_27)

Continuando con algunos otros datos, la siguiente gráfica muestra la proporción sobre el uso del servicio ecobici por edades registradas.

Por convención, se omitirán aquellos datos en el cual la edad es mayor a 85 años

new_bicycle_history_ecobici %>% 
  filter(year_user < 85) %>% 
  group_by(year_user) %>% 
  dplyr::summarise(count = n()) %>% 
  mutate(proportion = count/sum(count)) %>% 
  ggplot(aes(x = year_user, y = proportion, fill = proportion)) +
  geom_bar(stat = "identity") +
  ggtitle("Proporción de uso del servicio sobre la edad de los usuarios ")

¿Cuáles son las horas más y menos comunes de servicio?

by_hour <- new_bicycle_history_ecobici %>% 
    mutate(hora = hour(arr_datetime)) %>% 
    group_by(hora)  %>% 
    dplyr::summarise(conteo = n()) %>% 
  ggplot(aes(x = hora, y = conteo, fill = conteo)) +
  geom_bar(stat = "identity")+
  ggtitle("Cantidad de usuarios activos por hora")
ggplotly(by_hour)

Solo para aclarar:

new_bicycle_history_ecobici %>% 
  mutate(hora = hour(arr_datetime)) %>% 
  group_by(hora)  %>% 
  dplyr::summarise(conteo = n()) %>%
  arrange(desc(conteo))

Para finalizar, algunas preguntas sobre el genero de los usuarios.

gender <- ggplot(new_bicycle_history_ecobici, aes(gender_user, fill = gender_user)) +
  geom_bar() +
  scale_x_discrete(drop = FALSE)+
  ggtitle("Cantidad de usuarios por genero en los registros")
ggplotly(gender)

Es notable la diferencia entre la cantidad de hombres que utilizan este servicio contra el genero femenino.

Pero, con respecto a las horas, ¿Como se comporta la cantidad de mujeres y hombres que utilizan este servicio?

by_gender <- new_bicycle_history_ecobici %>% 
  mutate(hora = hour(arr_datetime)) %>% 
  group_by(hora, gender_user)  %>% 
  dplyr::summarise(conteo = n())

by_gender_hour <- ggplot(by_gender, aes(x = hora, y = conteo, color = gender_user)) + 
  geom_line() +
  facet_wrap(~ gender_user)

ggplotly(by_gender_hour)

Como se aprecia, se tiene un comportamiento similar en cuanto a las horas, solo cambia la cantidad por genero.

Final Proyect Data Analyst R

Carlos Fernando Vásquez Guerra

Data Profiling

Contexto

EDA